' Adds a podcast to the Windows Common Feed List and enables downloading
' of the feed's contents. Use IE7+ to remove a feed or change the number
' of items that are downloaded.

Option Explicit

Dim FeedsManager, Folder, Feed
Dim Shell, RegExp, sizelimit
Dim url, num
Feed = Null

Set RegExp = New RegExp
Set FeedsManager = CreateObject("Microsoft.FeedsManager") 
Set Folder = FeedsManager.Getfolder("Podcasts")

' Raise podcast size limit to 150 MB (default is 15 MB)

Const regfeedkey = "HKCU\Software\Microsoft\Feeds\MaxEnclosureSize"
Set Shell = CreateObject("WScript.Shell")
On Error Resume Next
sizelimit = Shell.RegRead(regfeedkey)
If Err.Number <> 0 Or sizelimit < 153600 Then
	Shell.RegWrite regfeedkey, 153600, "REG_DWORD"
End If
On Error Goto 0

' Parse URI

If WScript.Arguments.Count = 0 Then 
	Call UpdateLinksFolder()
	ExitDialog 0,"",Null 
Else
	url = WScript.Arguments(0)
	RegExp.IgnoreCase = True
	RegExp.pattern = "^feed:([a-z]+)?://"
	url = RegExp.replace(url,"$1://")
	RegExp.Pattern = "^feed://"
	url = RegExp.Replace(url,"http://")
End If

' Add podcast to Windows feed list

If FeedsManager.IsSubscribed(url) Then 
	Set Feed = FeedsManager.GetFeedbyUrl(url)
	Call UpdateLinksFolder()
	ExitDialog 0, "Already subscribed to " & Feed.Title & ".", 64
End If

If IsNull(Folder) Then
	Set Folder = FeedsManager.RootFolder.CreateSubfolder("Podcasts")
End If

On Error Resume Next
Set Feed = Folder.CreateFeed(url,url)
If Err.Number <> 0 Then 
	ExitDialog 1,url & " is not a valid podcast address.",48
End If
On Error Goto 0

num = InputBox("Number of episodes to download:","Subscribe to Podcast",10)
If (num = "") Then ExitDialog 1, "", Null ' User pressed Cancel
Feed.MaxItemCount = num

Feed.DownloadEnclosuresAutomatically = True
On Error Resume Next
Feed.Download()
If Err.Number <> 0 Then
	ExitDialog 1,"Failed to download podcast from " & url,48
End If
On Error Goto 0

Feed.Rename(Feed.Title) ' should check characters here
Call UpdateLinksFolder()
ExitDialog 0,"Subscribed to " & Feed.Name,64 ' Success

' Exit subroutine

Sub ExitDialog(ErrorFlag, Text, Icon)
	If Not IsNull(Feed) And ErrorFlag <> 0 Then Feed.Delete()
	If Text <> "" Then MsgBox Text, Icon, "Subscribe to Podcast"
	WScript.Quit(ErrorFlag)
End Sub

' Create/update links folder

Sub UpdateLinksFolder()
	Dim FS, path, fd, link
	Set FS = CreateObject("Scripting.FileSystemObject")
	path = Shell.RegRead("HKCU\Software\Microsoft\Windows\CurrentVersion\Explorer\User Shell Folders\My Music")
	path = Shell.ExpandEnvironmentStrings(path) & "\Podcasts"
	If Not FS.FolderExists(path) Then FS.CreateFolder(path)
	RegExp.pattern = "[\\/\?\*:\|<>""]" ' not allowed in filename
	RegExp.global = True
	For Each fd in FS.GetFolder(path).SubFolders
		If fd.Attributes & 1024 Then Shell.Run "cmd /C rd " & fd.shortpath, 0, True
	Next
	For Each fd in Folder.Feeds
		link = path & "\" & RegExp.replace(fd.Name,"")
		Shell.Run "cmd /C mklink /j """ & link & """ """ & _
		  fd.LocalEnclosurePath & """", 0, False
	Next

	Call UpdateAllTags()
	Set FS = nothing
End Sub

' Change genre tags to "Podcast"

Sub UpdateAllTags()
	Dim fd, itm, lp, mp
	Set mp = CreateObject("WMPlayer.OCX")

	For Each fd in Folder.Feeds
		For Each itm in fd.Items
			On Error Resume Next
			lp = itm.Enclosure.LocalPath
			If Err.Number <> 0 Then ' item does not exist
				lp = Null
				Err.Clear
			End If
			On Error Goto 0
			If Not IsNull(lp) Then
				If itm.Enclosure.DownloadStatus = 3 Then UpdateTags lp,fd,itm,mp
			End If
		Next
	Next
	
	Set mp = nothing
End Sub

Function UpdateTags(filename,fd,itm,Player)

	dim FS,File,Media
	dim ispodcast,readonly,numgen,i

	Const genre = "Podcast"

	Set FS = CreateObject("Scripting.FileSystemObject")
	Set File = FS.GetFile(filename)
	readonly = File.attributes AND 1
	If readonly Then File.attributes = File.attributes XOR 1

	Set Media = Player.newmedia(filename)

	If Not media.isreadonlyitem("Album") And _
	 StrComp(media.getiteminfo("Album"),fd.name) <> 0 Then 
		Media.setItemInfo "Album",fd.name
	End If

	numgen = Media.getAttributeCountByType("Genre","")
	ispodcast = False
	For i = 0 to (numgen-1)
		If StrComp(Media.getItemInfoByType("Genre","",i),genre,0) = 0 Then 
			ispodcast = True
		End If
	Next

	If Not ispodcast And Not media.isReadOnlyItem("Genre") Then
		Media.setItemInfo "Genre",genre
	End If

	set media = nothing ' needed to save album tag

	If readonly Then File.attributes = File.attributes XOR 1

End Function